SUBROUTINE BE2FTMI (CHID,NOMASTER,TBEG,TEND,TINT,COUNTER,SHELL)

IMPLICIT NONE

INTEGER, PARAMETER :: FB = SELECTED_REAL_KIND(6)
INTEGER :: I, J, K

CHARACTER(256) GRIDFILE,CHID,QFILE
INTEGER :: RCODE
LOGICAL :: EXISTS
INTEGER :: BATCHMODE

INTEGER COUNTER,SHELL
INTEGER SIZE,SIZE2
REAL TBEG,TEND,TINT,TIME
REAL NOMASTER(COUNTER,4)
REAL, ALLOCATABLE, DIMENSION(:,:) :: M_AST
REAL, ALLOCATABLE, DIMENSION(:) :: V_TIME,TAST 
CHARACTER(8) OUTFILE

INTEGER N_FACE(4)
INTEGER ONE_INTEGER
!OPEN(50,FILE='cputime.dat',FORM='FORMATTED',STATUS='UNKNOWN')
!CALL CPU_TIME (tb_init)

! Set a few default values
BATCHMODE=0

! Check to see if the .smv file exists
GRIDFILE = TRIM(CHID)//'.smv'
INQUIRE(FILE=GRIDFILE,EXIST=EXISTS)
IF (.NOT.EXISTS) THEN
   WRITE(6,*)"*** Fatal error: The file: ",TRIM(GRIDFILE)," does not exist"
   STOP
ENDIF

!VARIABLE_NUMBER: DO VAR=1,VARIABLE
!VAR=1
500 CONTINUE
IF (SHELL.EQ.1) COUNTER=COUNTER*2
SIZE=((TEND-TBEG)/TINT)+1
SIZE2=(TEND/TINT)+1
ALLOCATE (V_TIME(SIZE+1))
ALLOCATE (M_AST(COUNTER,SIZE+1))
ALLOCATE (TAST(COUNTER))
V_TIME=0.0
TAST=0.0
M_AST=0.0

             
! IN_LOOP is a loop at index file - SILVA, JC
!IN_LOOP: DO IN=VAR,VARIABLE*NMESHES,VARIABLE

QFILE = TRIM(CHID)//'_01.be'
OPEN(12,FILE=QFILE,FORM='UNFORMATTED',STATUS='OLD', IOSTAT=RCODE)
IF (RCODE.NE.0) THEN
  CLOSE(12)
  !CYCLE
  WRITE(6,*)"*** Fatal error: The file: ",TRIM(QFILE)," does not exist"
  STOP
ENDIF

WRITE(6,*)"COUPLING: Reading ",TRIM(QFILE)," file"
READ(12) ONE_INTEGER
!WRITE(6,*) ONE_INTEGER
READ(12) ONE_INTEGER
!WRITE(6,*) ONE_INTEGER
K=0

READ_LOOP: DO I=1,SIZE2
  READ(12) TIME
  IF (TIME.GE.TBEG .AND. INT(TIME).LE.TEND) THEN
    K=K+1
    V_TIME(K)=TIME
  !WRITE(6,*) TIME
  ENDIF
  READ(12) N_FACE
  !WRITE(6,*) N_FACE
  READ(12) TAST
  !WRITE(6,*) TAST
  IF (TIME.GE.TBEG .AND. INT(TIME).LE.TEND) THEN
    DO J=1,COUNTER
      M_AST(J,K)=TAST(J)
    ENDDO
  ENDIF

ENDDO READ_LOOP

CLOSE(12)
 
IF (SHELL.EQ.0) THEN
LOOP_FDS2AST: DO I=1,COUNTER
    WRITE (OUTFILE,'(g8.0)') INT(NOMASTER(I,1))
!    PRINT *, OUTFILE
!****************
!
!    OPEN(100,FILE=TRIM(OUTFILE)//'.dat',FORM='FORMATTED',STATUS='UNKNOWN')
      DO J=1,SIZE
        WRITE (70,'(A,A,A,I8,A,E12.5)') "*set,A", TRIM(OUTFILE), "(", J, ",0),", V_TIME(J)
        WRITE (70,'(A,A,A,I8,A,E12.5)') "*set,A", TRIM(OUTFILE), "(", J, ",1),", M_AST(I,J)
      ENDDO
!    CLOSE (100)
ENDDO LOOP_FDS2AST
ELSE 
LOOP_FDS2AST_SHELL: DO I=1,COUNTER,2
    WRITE (OUTFILE,'(g8.0)') INT(NOMASTER((I+1)/2,1))
!    PRINT *, OUTFILE
!****************
!    OPEN(100,FILE=TRIM(OUTFILE)//'.dat',FORM='FORMATTED',STATUS='UNKNOWN')
      DO J=1,SIZE
        WRITE (70,'(A,A,A,I8,A,E12.5)') "*set,A", TRIM(OUTFILE), "(", J, ",0),", V_TIME(J)
        WRITE (70,'(A,A,A,I8,A,E12.5)') "*set,A", TRIM(OUTFILE), "(", J, ",1),", (M_AST(I,J)+M_AST(I+1,J))/2
      ENDDO
!    CLOSE (100)
ENDDO LOOP_FDS2AST_SHELL
ENDIF


!ENDDO IN_LOOP

    DEALLOCATE (V_TIME)
    DEALLOCATE (TAST)
    DEALLOCATE (M_AST)


!ENDDO VARIABLE_NUMBER
IF (SHELL.EQ.1) COUNTER=COUNTER/2

RETURN
END SUBROUTINE BE2FTMI


! *********************** SEARCH *******************************

SUBROUTINE SEARCH(STRING,LENGTH,LU,IERR)

IMPLICIT NONE
CHARACTER(*), INTENT(IN) :: STRING
INTEGER, INTENT(OUT) :: IERR
INTEGER, INTENT(IN) :: LU, LENGTH
CHARACTER(20) :: JUNK

SEARCH_LOOP: DO 
   READ(LU,'(A)',END=10) JUNK
   IF (JUNK(1:LENGTH).EQ.STRING(1:LENGTH)) EXIT SEARCH_LOOP
ENDDO SEARCH_LOOP

IERR = 0
RETURN

10 IERR = 1
RETURN

END SUBROUTINE SEARCH

! *********************** SEARCH2 *******************************

SUBROUTINE SEARCH2(STRING,LENGTH,STRING2,LENGTH2,LU,IERR,CHOICE)

IMPLICIT NONE
CHARACTER(*), INTENT(IN) :: STRING,STRING2
CHARACTER(*), INTENT(OUT) :: CHOICE
INTEGER, INTENT(OUT) :: IERR
INTEGER, INTENT(IN) :: LU, LENGTH, LENGTH2
CHARACTER(20) :: JUNK

SEARCH_LOOP: DO 
   READ(LU,'(A)',END=10) JUNK
   IF (JUNK(1:LENGTH).EQ.STRING(1:LENGTH).OR.JUNK(1:LENGTH2).EQ.STRING2(1:LENGTH2)) THEN
      IF (JUNK(1:LENGTH) .EQ.STRING(1:LENGTH))   CHOICE = JUNK(1:LENGTH)
      IF (JUNK(1:LENGTH2).EQ.STRING2(1:LENGTH2)) CHOICE = JUNK(1:LENGTH2)
      EXIT SEARCH_LOOP
   ENDIF
ENDDO SEARCH_LOOP

IERR = 0
RETURN

10 IERR = 1
RETURN

END SUBROUTINE SEARCH2

! *********************** TOUPPER *******************************

SUBROUTINE TOUPPER(BUFFERIN, BUFFEROUT)
CHARACTER(LEN=*), INTENT(IN) :: BUFFERIN
CHARACTER(LEN=*), INTENT(OUT) :: BUFFEROUT
CHARACTER(LEN=1) :: C

INTEGER :: LENBUF, I

LENBUF=MIN(LEN(TRIM(BUFFERIN)),LEN(BUFFEROUT))
DO I = 1, LENBUF
   C = BUFFERIN(I:I)
   IF(C.GE.'a'.AND.C.LE.'z')C=CHAR(ICHAR(C)+ICHAR('A')-ICHAR('a'))
    BUFFEROUT(I:I)=C
END DO

END SUBROUTINE TOUPPER
